home *** CD-ROM | disk | FTP | other *** search
/ Netscape Plug-Ins Developer's Kit / Netscape_Plug-Ins_Developers_Kit.iso / CGIPERL / MACPERL / MSRCE418.HQX / Perl Source ƒ / Perl / eval.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-10-30  |  61.5 KB  |  2,689 lines
  1. /* $RCSfile: eval.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 13:20:20 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of the Perl Artistic License,
  6.  *    as specified in the README file.
  7.  *
  8.  * $Log:    eval.c,v $
  9.  * Revision 4.0.1.4  92/06/08  13:20:20  lwall
  10.  * patch20: added explicit time_t support
  11.  * patch20: fixed confusion between a *var's real name and its effective name
  12.  * patch20: added Atari ST portability
  13.  * patch20: new warning for use of x with non-numeric right operand
  14.  * patch20: modulus with highest bit in left operand set didn't always work
  15.  * patch20: dbmclose(%array) didn't work
  16.  * patch20: added ... as variant on ..
  17.  * patch20: O_PIPE conflicted with Atari
  18.  * 
  19.  * Revision 4.0.1.3  91/11/05  17:15:21  lwall
  20.  * patch11: prepared for ctype implementations that don't define isascii()
  21.  * patch11: various portability fixes
  22.  * patch11: added sort {} LIST
  23.  * patch11: added eval {}
  24.  * patch11: sysread() in socket was substituting recv()
  25.  * patch11: a last statement outside any block caused occasional core dumps
  26.  * patch11: missing arguments caused core dump in -D8 code
  27.  * patch11: eval 'stuff' now optimized to eval {stuff}
  28.  * 
  29.  * Revision 4.0.1.2  91/06/07  11:07:23  lwall
  30.  * patch4: new copyright notice
  31.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  32.  * patch4: assignment wasn't correctly de-tainting the assigned variable.
  33.  * patch4: default top-of-form format is now FILEHANDLE_TOP
  34.  * patch4: added $^P variable to control calling of perldb routines
  35.  * patch4: taintchecks could improperly modify parent in vfork()
  36.  * patch4: many, many itty-bitty portability fixes
  37.  * 
  38.  * Revision 4.0.1.1  91/04/11  17:43:48  lwall
  39.  * patch1: fixed failed fork to return undef as documented
  40.  * patch1: reduced maximum branch distance in eval.c
  41.  * 
  42.  * Revision 4.0  91/03/20  01:16:48  lwall
  43.  * 4.0 baseline.
  44.  * 
  45.  */
  46.  
  47. #include "EXTERN.h"
  48. #include "perl.h"
  49.  
  50. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  51. #include <signal.h>
  52. #endif
  53.  
  54. #ifdef I_FCNTL
  55. #include <fcntl.h>
  56. #endif
  57. #ifdef MSDOS
  58. /* I_FCNTL *MUST* not be defined for MS-DOS and OS/2
  59.    but fcntl.h is required for O_BINARY */
  60. #include <fcntl.h>
  61. #endif
  62. #ifdef I_SYS_FILE
  63. #include <sys/file.h>
  64. #endif
  65. #ifdef I_VFORK
  66. #   include <vfork.h>
  67. #endif
  68.  
  69. #ifdef VOIDSIG
  70. static void (*ihand)();
  71. static void (*qhand)();
  72. #else
  73. static int (*ihand)();
  74. static int (*qhand)();
  75. #endif
  76.  
  77. ARG *debarg;
  78. STR str_args;
  79. static STAB *stab2;
  80. static STIO *stio;
  81. static struct lstring *lstr;
  82. static int old_rschar;
  83. static int old_rslen;
  84.  
  85. char *getlogin();
  86.  
  87. #include <Math.h>
  88.  
  89. #undef SMALLSWITCHES
  90.  
  91. char *crypt();
  92. extern void grow_dlevel();
  93.  
  94. int
  95. eval(arg,gimme,sp)
  96. register ARG *arg;
  97. int gimme;
  98. register int sp;
  99. {
  100.     STR *        str;
  101.     int         anum;
  102.     int         optype;
  103.     STR **        st;
  104.     int         maxarg;
  105.     double         value;
  106.     char *        tmps;
  107.     char *        tmps2;
  108.     int         argflags;
  109.     int         argtype;
  110.     union argptr     argptr;
  111.     int         arglast[8];    /* highest sp for arg--valid only for non-O_LIST args */
  112.     unsigned long     tmpulong;
  113.     long         tmplong;
  114.     long        longo;
  115.     time_t         when;
  116.     STRLEN        tmplen;
  117.     FILE *        fp;
  118.     STR *        tmpstr;
  119.     FCMD *        form;
  120.     STAB *        stab;
  121.     ARRAY *        ary;
  122.     bool         assigning;
  123.     
  124.     assigning    =    FALSE;
  125.     
  126.     if (!arg)
  127.     goto say_undef;
  128.     optype = arg->arg_type;
  129.     maxarg = arg->arg_len;
  130.     arglast[0] = sp;
  131.     str = arg->arg_ptr.arg_str;
  132.     if (sp + maxarg > stack->ary_max)
  133.     astore(stack, sp + maxarg, Nullstr);
  134.     st = stack->ary_array;
  135.  
  136. #ifdef DEBUGGING
  137.     if (debug) {
  138.     if (debug & 8) {
  139.         deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
  140.     }
  141.     debname[dlevel] = opname[optype][0];
  142.     debdelim[dlevel] = ':';
  143.     if (++dlevel >= dlmax)
  144.         grow_dlevel();
  145.     }
  146. #endif
  147.  
  148.     for (anum = 1; anum <= maxarg; anum++) {
  149.     argflags = arg[anum].arg_flags;
  150.     argtype = arg[anum].arg_type;
  151.     argptr = arg[anum].arg_ptr;
  152.       re_eval:
  153.     switch (argtype) {
  154.     default:
  155.         st[++sp] = &str_undef;
  156. #ifdef DEBUGGING
  157.         tmps = "NULL";
  158. #endif
  159.         break;
  160.     case A_EXPR:
  161. #ifdef DEBUGGING
  162.         if (debug & 8) {
  163.         tmps = "EXPR";
  164.         deb("%d.EXPR =>\n",anum);
  165.         }
  166. #endif
  167.         sp = eval(argptr.arg_arg,
  168.         (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp);
  169.         if (sp + (maxarg - anum) > stack->ary_max)
  170.         astore(stack, sp + (maxarg - anum), Nullstr);
  171.         st = stack->ary_array;    /* possibly reallocated */
  172.         break;
  173.         case A_CMD:
  174. #ifdef DEBUGGING
  175.         if (debug & 8) {
  176.         tmps = "CMD";
  177.         deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
  178.         }
  179. #endif
  180.         sp = cmd_exec(argptr.arg_cmd, gimme, sp);
  181.         if (sp + (maxarg - anum) > stack->ary_max)
  182.         astore(stack, sp + (maxarg - anum), Nullstr);
  183.         st = stack->ary_array;    /* possibly reallocated */
  184.         break;
  185.         case A_LARYSTAB:
  186.         ++sp;
  187.         switch (optype) {
  188.         case O_ITEM2: argtype = 2; break;
  189.         case O_ITEM3: argtype = 3; break;
  190.         default:      argtype = anum; break;
  191.         }
  192.         str = afetch(stab_array(argptr.arg_stab),
  193.         arg[argtype].arg_len - arybase, TRUE);
  194. #ifdef DEBUGGING
  195.         if (debug & 8) {
  196.         (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
  197.             arg[argtype].arg_len);
  198.         tmps = buf;
  199.         }
  200. #endif
  201.         goto do_crement;
  202.         case A_ARYSTAB:
  203.         switch (optype) {
  204.         case O_ITEM2: argtype = 2; break;
  205.         case O_ITEM3: argtype = 3; break;
  206.         default:      argtype = anum; break;
  207.         }
  208.         st[++sp] = afetch(stab_array(argptr.arg_stab),
  209.         arg[argtype].arg_len - arybase, FALSE);
  210. #ifdef DEBUGGING
  211.         if (debug & 8) {
  212.         (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
  213.             arg[argtype].arg_len);
  214.         tmps = buf;
  215.         }
  216. #endif
  217.         break;
  218.     case A_STAR:
  219.         stab = argptr.arg_stab;
  220.         st[++sp] = (STR*)stab;
  221.         if (!stab_xarray(stab))
  222.         aadd(stab);
  223.         if (!stab_xhash(stab))
  224.         hadd(stab);
  225.         if (!stab_io(stab))
  226.         stab_io(stab) = stio_new();
  227. #ifdef DEBUGGING
  228.         if (debug & 8) {
  229.         (void)sprintf(buf,"STAR *%s -> *%s",
  230.             stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
  231.         tmps = buf;
  232.         }
  233. #endif
  234.         break;
  235.     case A_LSTAR:
  236.         str = st[++sp] = (STR*)argptr.arg_stab;
  237. #ifdef DEBUGGING
  238.         if (debug & 8) {
  239.         (void)sprintf(buf,"LSTAR *%s -> *%s",
  240.             stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
  241.         tmps = buf;
  242.         }
  243. #endif
  244.         break;
  245.     case A_STAB:
  246.         st[++sp] = STAB_STR(argptr.arg_stab);
  247. #ifdef DEBUGGING
  248.         if (debug & 8) {
  249.         (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab));
  250.         tmps = buf;
  251.         }
  252. #endif
  253.         break;
  254.     case A_LENSTAB:
  255.         str_numset(str, (double)STAB_LEN(argptr.arg_stab));
  256.         st[++sp] = str;
  257. #ifdef DEBUGGING
  258.         if (debug & 8) {
  259.         (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab));
  260.         tmps = buf;
  261.         }
  262. #endif
  263.         break;
  264.     case A_LEXPR:
  265. #ifdef DEBUGGING
  266.         if (debug & 8) {
  267.         tmps = "LEXPR";
  268.         deb("%d.LEXPR =>\n",anum);
  269.         }
  270. #endif
  271.         if (argflags & AF_ARYOK) {
  272.         sp = eval(argptr.arg_arg, G_ARRAY, sp);
  273.         if (sp + (maxarg - anum) > stack->ary_max)
  274.             astore(stack, sp + (maxarg - anum), Nullstr);
  275.         st = stack->ary_array;    /* possibly reallocated */
  276.         }
  277.         else {
  278.         sp = eval(argptr.arg_arg, G_SCALAR, sp);
  279.         st = stack->ary_array;    /* possibly reallocated */
  280.         str = st[sp];
  281.         goto do_crement;
  282.         }
  283.         break;
  284.     case A_LVAL:
  285. #ifdef DEBUGGING
  286.         if (debug & 8) {
  287.         (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab));
  288.         tmps = buf;
  289.         }
  290. #endif
  291.         ++sp;
  292.         str = STAB_STR(argptr.arg_stab);
  293.         if (!str)
  294.         fatal("panic: A_LVAL");
  295.       do_crement:
  296.         assigning = TRUE;
  297.         if (argflags & AF_PRE) {
  298.         if (argflags & AF_UP)
  299.             str_inc(str);
  300.         else
  301.             str_dec(str);
  302.         STABSET(str);
  303.         st[sp] = str;
  304.         str = arg->arg_ptr.arg_str;
  305.         }
  306.         else if (argflags & AF_POST) {
  307.         st[sp] = str_mortal(str);
  308.         if (argflags & AF_UP)
  309.             str_inc(str);
  310.         else
  311.             str_dec(str);
  312.         STABSET(str);
  313.         str = arg->arg_ptr.arg_str;
  314.         }
  315.         else
  316.         st[sp] = str;
  317.         break;
  318.     case A_LARYLEN:
  319.         ++sp;
  320.         stab = argptr.arg_stab;
  321.         str = stab_array(argptr.arg_stab)->ary_magic;
  322.         if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST))
  323.         str_numset(str,(double)(stab_array(stab)->ary_fill+arybase));
  324. #ifdef DEBUGGING
  325.         tmps = "LARYLEN";
  326. #endif
  327.         if (!str)
  328.         fatal("panic: A_LEXPR");
  329.         goto do_crement;
  330.     case A_ARYLEN:
  331.         stab = argptr.arg_stab;
  332.         st[++sp] = stab_array(stab)->ary_magic;
  333.         str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase));
  334. #ifdef DEBUGGING
  335.         tmps = "ARYLEN";
  336. #endif
  337.         break;
  338.     case A_SINGLE:
  339.         st[++sp] = argptr.arg_str;
  340. #ifdef DEBUGGING
  341.         tmps = "SINGLE";
  342. #endif
  343.         break;
  344.     case A_DOUBLE:
  345.         (void) interp(str,argptr.arg_str,sp);
  346.         st = stack->ary_array;
  347.         st[++sp] = str;
  348. #ifdef DEBUGGING
  349.         tmps = "DOUBLE";
  350. #endif
  351.         break;
  352.     case A_BACKTICK:
  353.         tmps = str_get(interp(str,argptr.arg_str,sp));
  354.         st = stack->ary_array;
  355.         fp = mypopen(tmps,"r");
  356.         str_set(str,"");
  357.         if (fp) {
  358.         if (gimme == G_SCALAR) {
  359.             while (str_gets(str,fp,str->str_cur) != Nullch)
  360.             /*SUPPRESS 530*/
  361.             ;
  362.         }
  363.         else {
  364.             for (;;) {
  365.             if (++sp > stack->ary_max) {
  366.                 astore(stack, sp, Nullstr);
  367.                 st = stack->ary_array;
  368.             }
  369.             str = st[sp] = Str_new(56,80);
  370.             if (str_gets(str,fp,0) == Nullch) {
  371.                 sp--;
  372.                 break;
  373.             }
  374.             if (str->str_len - str->str_cur > 20) {
  375.                 str->str_len = str->str_cur+1;
  376.                 Renew(str->str_ptr, str->str_len, char);
  377.             }
  378.             str_2mortal(str);
  379.             }
  380.         }
  381.         statusvalue = mypclose(fp);
  382.         }
  383.         else
  384.         statusvalue = -1;
  385.  
  386.         if (gimme == G_SCALAR)
  387.         st[++sp] = str;
  388. #ifdef DEBUGGING
  389.         tmps = "BACK";
  390. #endif
  391.         break;
  392.     case A_WANTARRAY:
  393.         {
  394.         if (curcsv->wantarray == G_ARRAY)
  395.             st[++sp] = &str_yes;
  396.         else
  397.             st[++sp] = &str_no;
  398.         }
  399. #ifdef DEBUGGING
  400.         tmps = "WANTARRAY";
  401. #endif
  402.         break;
  403.     case A_INDREAD:
  404.         last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
  405.         old_rschar = rschar;
  406.         old_rslen = rslen;
  407.         goto do_read;
  408.     case A_GLOB:
  409.         argflags |= AF_POST;    /* enable newline chopping */
  410.         last_in_stab = argptr.arg_stab;
  411.         old_rschar = rschar;
  412.         old_rslen = rslen;
  413.         rslen = 1;
  414.         rschar = '\n';
  415.         goto do_read;
  416.     case A_READ:
  417.         last_in_stab = argptr.arg_stab;
  418.         old_rschar = rschar;
  419.         old_rslen = rslen;
  420.       do_read:
  421.         if (anum > 1)        /* assign to scalar */
  422.         gimme = G_SCALAR;    /* force context to scalar */
  423.         if (gimme == G_ARRAY)
  424.         str = Str_new(57,0);
  425.         ++sp;
  426.         fp = Nullfp;
  427.         if (stab_io(last_in_stab)) {
  428.         fp = stab_io(last_in_stab)->ifp;
  429.         if (!fp) {
  430.             if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  431.             if (stab_io(last_in_stab)->flags & IOF_START) {
  432.                 stab_io(last_in_stab)->flags &= ~IOF_START;
  433.                 stab_io(last_in_stab)->lines = 0;
  434.                 if (alen(stab_array(last_in_stab)) < 0) {
  435.                 tmpstr = str_make("-",1); /* assume stdin */
  436.                 (void)apush(stab_array(last_in_stab), tmpstr);
  437.                 }
  438.             }
  439.             fp = nextargv(last_in_stab);
  440.             if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */
  441.                 (void)do_close(last_in_stab,FALSE); /* now it does*/
  442.                 stab_io(last_in_stab)->flags |= IOF_START;
  443.             }
  444.             }
  445.             else if (argtype == A_GLOB) {
  446.             (void) interp(str,stab_val(last_in_stab),sp);
  447.             st = stack->ary_array;
  448.             tmpstr = Str_new(55,0);
  449.             str_set(tmpstr, "For i in ");
  450.             str_scat(tmpstr, str);
  451.             str_cat(tmpstr,"; echo \"{i}\"; end |");
  452.             (void)do_open(last_in_stab,tmpstr->str_ptr,
  453.               tmpstr->str_cur);
  454.             fp = stab_io(last_in_stab)->ifp;
  455.             str_free(tmpstr);
  456.             }
  457.         }
  458.         }
  459.         if (!fp && dowarn)
  460.         warn("Read on closed filehandle <%s>",stab_ename(last_in_stab));
  461.         tmplen = str->str_len;    /* remember if already alloced */
  462.         if (!tmplen)
  463.         Str_Grow(str,80);    /* try short-buffering it */
  464.       keepgoing:
  465.         if (!fp)
  466.         st[sp] = &str_undef;
  467.         else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) {
  468.         clearerr(fp);
  469.         if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  470.             fp = nextargv(last_in_stab);
  471.             if (fp)
  472.             goto keepgoing;
  473.             (void)do_close(last_in_stab,FALSE);
  474.             stab_io(last_in_stab)->flags |= IOF_START;
  475.         }
  476.         else if (argflags & AF_POST) {
  477.             (void)do_close(last_in_stab,FALSE);
  478.         }
  479.         st[sp] = &str_undef;
  480.         rschar = old_rschar;
  481.         rslen = old_rslen;
  482.         if (gimme == G_ARRAY) {
  483.             --sp;
  484.             str_2mortal(str);
  485.             goto array_return;
  486.         }
  487.         break;
  488.         }
  489.         else {
  490.         stab_io(last_in_stab)->lines++;
  491.         st[sp] = str;
  492.         if (argflags & AF_POST) {
  493.             if (str->str_cur > 0)
  494.             str->str_cur--;
  495.             if (str->str_ptr[str->str_cur] == rschar)
  496.             str->str_ptr[str->str_cur] = '\0';
  497.             else
  498.             str->str_cur++;
  499.             for (tmps = str->str_ptr; *tmps; tmps++)
  500.             if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
  501.                 index("$&*(){}[]'\";\\|?<>~`",*tmps))
  502.                 break;
  503.             if (*tmps && stat(str->str_ptr,&statbuf) < 0)
  504.             goto keepgoing;        /* unmatched wildcard? */
  505.         }
  506.         if (gimme == G_ARRAY) {
  507.             if (str->str_len - str->str_cur > 20) {
  508.             str->str_len = str->str_cur+1;
  509.             Renew(str->str_ptr, str->str_len, char);
  510.             }
  511.             str_2mortal(str);
  512.             if (++sp > stack->ary_max) {
  513.             astore(stack, sp, Nullstr);
  514.             st = stack->ary_array;
  515.             }
  516.             str = Str_new(58,80);
  517.             goto keepgoing;
  518.         }
  519.         else if (!tmplen && str->str_len - str->str_cur > 80) {
  520.             /* try to reclaim a bit of scalar space on 1st alloc */
  521.             if (str->str_cur < 60)
  522.             str->str_len = 80;
  523.             else
  524.             str->str_len = str->str_cur+40;    /* allow some slop */
  525.             Renew(str->str_ptr, str->str_len, char);
  526.         }
  527.         }
  528.         rschar = old_rschar;
  529.         rslen = old_rslen;
  530. #ifdef DEBUGGING
  531.         tmps = "READ";
  532. #endif
  533.         break;
  534.     }
  535. #ifdef DEBUGGING
  536.     if (debug & 8)
  537.         deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp]));
  538. #endif
  539.     if (anum < 8)
  540.         arglast[anum] = sp;
  541.     }
  542.  
  543.     st += arglast[0];
  544.     switch (optype) {
  545.  
  546.     case O_RCAT:
  547.     STABSET(str);
  548.     break;
  549.     case O_ITEM:
  550.     if (gimme == G_ARRAY)
  551.         goto array_return;
  552.     /* FALL THROUGH */
  553.     case O_SCALAR:
  554.     STR_SSET(str,st[1]);
  555.     STABSET(str);
  556.     break;
  557.     case O_ITEM2:
  558.     if (gimme == G_ARRAY)
  559.         goto array_return;
  560.     --anum;
  561.     STR_SSET(str,st[arglast[anum]-arglast[0]]);
  562.     STABSET(str);
  563.     break;
  564.     case O_ITEM3:
  565.     if (gimme == G_ARRAY)
  566.     goto array_return;
  567.     --anum;
  568.     STR_SSET(str,st[arglast[anum]-arglast[0]]);
  569.     STABSET(str);
  570.     break;
  571.     case O_CONCAT:
  572.     STR_SSET(str,st[1]);
  573.     str_scat(str,st[2]);
  574.     STABSET(str);
  575.     break;
  576.     case O_REPEAT:
  577.     if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) {
  578.         sp = do_repeatary(arglast);
  579.         goto array_return;
  580.     }
  581.     STR_SSET(str,st[1]);
  582.     anum = (int)str_gnum(st[2]);
  583.     if (anum >= 1) {
  584.         tmpstr = Str_new(50, 0);
  585.         tmps = str_get(str);
  586.         str_nset(tmpstr,tmps,str->str_cur);
  587.         tmps = str_get(tmpstr);    /* force to be string */
  588.         STR_GROW(str, (anum * str->str_cur) + 1);
  589.         repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
  590.         str->str_cur *= anum;
  591.         str->str_ptr[str->str_cur] = '\0';
  592.         str->str_nok = 0;
  593.         str_free(tmpstr);
  594.     }
  595.     else {
  596.         if (dowarn && st[2]->str_pok && !looks_like_number(st[2]))
  597.             warn("Right operand of x is not numeric");
  598.         str_sset(str,&str_no);
  599.     }
  600.     STABSET(str);
  601.     break;
  602.     case O_MATCH:
  603.     sp = do_match(str,arg,
  604.       gimme,arglast);
  605.     if (gimme == G_ARRAY)
  606.         goto array_return;
  607.     STABSET(str);
  608.     break;
  609.     case O_NMATCH:
  610.     sp = do_match(str,arg,
  611.       G_SCALAR,arglast);
  612.     str_sset(str, str_true(str) ? &str_no : &str_yes);
  613.     STABSET(str);
  614.     break;
  615.     case O_SUBST:
  616.     sp = do_subst(str,arg,arglast[0]);
  617.     goto array_return;
  618.     case O_NSUBST:
  619.     sp = do_subst(str,arg,arglast[0]);
  620.     str = arg->arg_ptr.arg_str;
  621.     str_set(str, str_true(str) ? No : Yes);
  622.     goto array_return;
  623.     case O_ASSIGN:
  624.     if (arg[1].arg_flags & AF_ARYOK) {
  625.         if (arg->arg_len == 1) {
  626.         arg->arg_type = O_LOCAL;
  627.         goto local;
  628.         }
  629.         else {
  630.         arg->arg_type = O_AASSIGN;
  631.         goto aassign;
  632.         }
  633.     }
  634.     else {
  635.         arg->arg_type = O_SASSIGN;
  636.         goto sassign;
  637.     }
  638.     case O_LOCAL:
  639.       local:
  640.     arglast[2] = arglast[1];    /* push a null array */
  641.     /* FALL THROUGH */
  642.     case O_AASSIGN:
  643.       aassign:
  644.     sp = do_assign(arg,
  645.       gimme,arglast);
  646.     goto array_return;
  647.     case O_SASSIGN:
  648.       sassign:
  649.     STR_SSET(str, st[2]);
  650.     STABSET(str);
  651.     break;
  652.     case O_CHOP:
  653.     st -= arglast[0];
  654.     str = arg->arg_ptr.arg_str;
  655.     for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
  656.         do_chop(str,st[sp]);
  657.     st += arglast[0];
  658.     break;
  659.     case O_DEFINED:
  660.     if (arg[1].arg_type & A_DONT) {
  661.         sp = do_defined(str,arg,
  662.           gimme,arglast);
  663.         goto array_return;
  664.     }
  665.     else if (str->str_pok || str->str_nok)
  666.         goto say_yes;
  667.     goto say_no;
  668.     case O_UNDEF:
  669.     if (arg[1].arg_type & A_DONT) {
  670.         sp = do_undef(str,arg,
  671.           gimme,arglast);
  672.         goto array_return;
  673.     }
  674.     else if (str != stab_val(defstab)) {
  675.         if (str->str_len) {
  676.         if (str->str_state == SS_INCR)
  677.             Str_Grow(str,0);
  678.         Safefree(str->str_ptr);
  679.         str->str_ptr = Nullch;
  680.         str->str_len = 0;
  681.         }
  682.         str->str_pok = str->str_nok = 0;
  683.         STABSET(str);
  684.     }
  685.     goto say_undef;
  686.     case O_STUDY:
  687.     sp = do_study(str,arg,
  688.       gimme,arglast);
  689.     goto array_return;
  690.     case O_POW:
  691.     value = str_gnum(st[1]);
  692.     value = pow(value,str_gnum(st[2]));
  693.     goto donumset;
  694.     case O_MULTIPLY:
  695.     value = str_gnum(st[1]);
  696.     value *= str_gnum(st[2]);
  697.     goto donumset;
  698.     case O_DIVIDE:
  699.     if ((value = str_gnum(st[2])) == 0.0)
  700.         fatal("Illegal division by zero");
  701.     value = str_gnum(st[1]) / value;
  702.     goto donumset;
  703.     case O_MODULO:
  704.     tmpulong = (unsigned long) str_gnum(st[2]);
  705.         if (tmpulong == 0L)
  706.         fatal("Illegal modulus zero");
  707.     value = str_gnum(st[1]);
  708.     if (value >= 0.0)
  709.         value = (double)((unsigned long) value % tmpulong);
  710.     else {
  711.         tmplong = (long) value;
  712.         value   = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
  713.     }
  714.     goto donumset;
  715.     case O_ADD:
  716.     value = str_gnum(st[1]);
  717.     value += str_gnum(st[2]);
  718.     goto donumset;
  719.     case O_SUBTRACT:
  720.     value = str_gnum(st[1]);
  721.     value -= str_gnum(st[2]);
  722.     goto donumset;
  723.     case O_LEFT_SHIFT:
  724.     value = str_gnum(st[1]);
  725.     anum = (int)str_gnum(st[2]);
  726.     value = (double)(U_L(value) << anum);
  727.     goto donumset;
  728.     case O_RIGHT_SHIFT:
  729.     value = str_gnum(st[1]);
  730.     anum = (int)str_gnum(st[2]);
  731.     value = (double)(U_L(value) >> anum);
  732.     goto donumset;
  733.     case O_LT:
  734.     value = str_gnum(st[1]);
  735.     value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
  736.     goto donumset;
  737.     case O_GT:
  738.     value = str_gnum(st[1]);
  739.     value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
  740.     goto donumset;
  741.     case O_LE:
  742.     value = str_gnum(st[1]);
  743.     value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
  744.     goto donumset;
  745.     case O_GE:
  746.     value = str_gnum(st[1]);
  747.     value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
  748.     goto donumset;
  749.     case O_EQ:
  750.     if (dowarn) {
  751.         if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
  752.         (!st[2]->str_nok && !looks_like_number(st[2])) )
  753.         warn("Possible use of == on string value");
  754.     }
  755.     value = str_gnum(st[1]);
  756.     value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
  757.     goto donumset;
  758.     case O_NE:
  759.     value = str_gnum(st[1]);
  760.     value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
  761.     goto donumset;
  762.     case O_NCMP:
  763.     value = str_gnum(st[1]);
  764.     value -= str_gnum(st[2]);
  765.     if (value > 0.0)
  766.         value = 1.0;
  767.     else if (value < 0.0)
  768.         value = -1.0;
  769.     goto donumset;
  770.     case O_BIT_AND:
  771.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  772.         value = str_gnum(st[1]);
  773.         value = (double)(U_L(value) & U_L(str_gnum(st[2])));
  774.         goto donumset;
  775.     }
  776.     else
  777.         do_vop(optype,str,st[1],st[2]);
  778.     break;
  779.     case O_XOR:
  780.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  781.         value = str_gnum(st[1]);
  782.         value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
  783.         goto donumset;
  784.     }
  785.     else
  786.         do_vop(optype,str,st[1],st[2]);
  787.     break;
  788.     case O_BIT_OR:
  789.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  790.         value = str_gnum(st[1]);
  791.         value = (double)(U_L(value) | U_L(str_gnum(st[2])));
  792.         goto donumset;
  793.     }
  794.     else
  795.         do_vop(optype,str,st[1],st[2]);
  796.     break;
  797. /* use register in evaluating str_true() */
  798.     case O_AND:
  799.     if (str_true(st[1])) {
  800.         anum = 2;
  801.         optype = O_ITEM2;
  802.         argflags = arg[anum].arg_flags;
  803.         if (gimme == G_ARRAY)
  804.         argflags |= AF_ARYOK;
  805.         argtype = arg[anum].arg_type & A_MASK;
  806.         argptr = arg[anum].arg_ptr;
  807.         maxarg = anum = 1;
  808.         sp = arglast[0];
  809.         st -= sp;
  810.         goto re_eval;
  811.     }
  812.     else {
  813.         if (assigning) {
  814.         str_sset(str, st[1]);
  815.         STABSET(str);
  816.         }
  817.         else
  818.         str = st[1];
  819.         break;
  820.     }
  821.     case O_OR:
  822.     if (str_true(st[1])) {
  823.         if (assigning) {
  824.         str_sset(str, st[1]);
  825.         STABSET(str);
  826.         }
  827.         else
  828.         str = st[1];
  829.         break;
  830.     }
  831.     else {
  832.         anum = 2;
  833.         optype = O_ITEM2;
  834.         argflags = arg[anum].arg_flags;
  835.         if (gimme == G_ARRAY)
  836.         argflags |= AF_ARYOK;
  837.         argtype = arg[anum].arg_type & A_MASK;
  838.         argptr = arg[anum].arg_ptr;
  839.         maxarg = anum = 1;
  840.         sp = arglast[0];
  841.         st -= sp;
  842.         goto re_eval;
  843.     }
  844.     case O_COND_EXPR:
  845.     anum = (str_true(st[1]) ? 2 : 3);
  846.     optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
  847.     argflags = arg[anum].arg_flags;
  848.     if (gimme == G_ARRAY)
  849.         argflags |= AF_ARYOK;
  850.     argtype = arg[anum].arg_type & A_MASK;
  851.     argptr = arg[anum].arg_ptr;
  852.     maxarg = anum = 1;
  853.     sp = arglast[0];
  854.     st -= sp;
  855.     goto re_eval;
  856.     case O_COMMA:
  857.     if (gimme == G_ARRAY)
  858.         goto array_return;
  859.     str = st[2];
  860.     break;
  861.     case O_NEGATE:
  862.     value = -str_gnum(st[1]);
  863.     goto donumset;
  864.     case O_NOT:
  865. #ifdef NOTNOT
  866.     { char xxx = str_true(st[1]); value = (double) !xxx; }
  867. #else
  868.       value = (double) !str_true(st[1]);
  869. #endif
  870.     goto donumset;
  871.     case O_COMPLEMENT:
  872.     if (!sawvec || st[1]->str_nok) {
  873.         value = (double) ~U_L(str_gnum(st[1]));
  874.         goto donumset;
  875.     }
  876.     else {
  877.         STR_SSET(str,st[1]);
  878.         tmps = str_get(str);
  879.         for (anum = str->str_cur; anum; anum--, tmps++)
  880.         *tmps = ~*tmps;
  881.     }
  882.     break;
  883.     case O_SELECT:
  884.     stab_efullname(str,defoutstab);
  885.     if (maxarg > 0) {
  886.         if ((arg[1].arg_type & A_MASK) == A_WORD)
  887.         defoutstab = arg[1].arg_ptr.arg_stab;
  888.         else
  889.         defoutstab = stabent(str_get(st[1]),TRUE);
  890.         if (!stab_io(defoutstab))
  891.         stab_io(defoutstab) = stio_new();
  892.         curoutstab = defoutstab;
  893.     }
  894.     STABSET(str);
  895.     break;
  896.     case O_WRITE:
  897.     if (maxarg == 0)
  898.         stab = defoutstab;
  899.     else if ((arg[1].arg_type & A_MASK) == A_WORD) {
  900.         if (!(stab = arg[1].arg_ptr.arg_stab))
  901.         stab = defoutstab;
  902.     }
  903.     else
  904.         stab = stabent(str_get(st[1]),TRUE);
  905.     if (!stab_io(stab)) {
  906.         str_set(str, No);
  907.         STABSET(str);
  908.         break;
  909.     }
  910.     curoutstab = stab;
  911.     fp = stab_io(stab)->ofp;
  912.     debarg = arg;
  913.     if (stab_io(stab)->fmt_stab)
  914.         form = stab_form(stab_io(stab)->fmt_stab);
  915.     else
  916.         form = stab_form(stab);
  917.     if (!form || !fp) {
  918.         if (dowarn) {
  919.         if (form)
  920.             warn("No format for filehandle");
  921.         else {
  922.             if (stab_io(stab)->ifp)
  923.             warn("Filehandle only opened for input");
  924.             else
  925.             warn("Write on closed filehandle");
  926.         }
  927.         }
  928.         str_set(str, No);
  929.         STABSET(str);
  930.         break;
  931.     }
  932.     format(&outrec,form,sp);
  933.     do_write(&outrec,stab,sp);
  934.     if (stab_io(stab)->flags & IOF_FLUSH)
  935.         (void)fflush(fp);
  936.     str_set(str, Yes);
  937.     STABSET(str);
  938.     break;
  939.     case O_DBMOPEN:
  940. #ifdef SOME_DBM
  941.     anum = arg[1].arg_type & A_MASK;
  942.     if (anum == A_WORD || anum == A_STAB)
  943.         stab = arg[1].arg_ptr.arg_stab;
  944.     else
  945.         stab = stabent(str_get(st[1]),TRUE);
  946.     if (st[3]->str_nok || st[3]->str_pok)
  947.         anum = (int)str_gnum(st[3]);
  948.     else
  949.         anum = -1;
  950.     value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
  951.     goto donumset;
  952. #else
  953.     fatal("No dbm or ndbm on this machine");
  954. #endif
  955.     case O_DBMCLOSE:
  956. #ifdef SOME_DBM
  957.     anum = arg[1].arg_type & A_MASK;
  958.     if (anum == A_WORD || anum == A_STAB)
  959.         stab = arg[1].arg_ptr.arg_stab;
  960.     else
  961.         stab = stabent(str_get(st[1]),TRUE);
  962.     hdbmclose(stab_hash(stab));
  963.     goto say_yes;
  964. #else
  965.     fatal("No dbm or ndbm on this machine");
  966. #endif
  967.     case O_OPEN:
  968.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  969.         stab = arg[1].arg_ptr.arg_stab;
  970.     else
  971.         stab = stabent(str_get(st[1]),TRUE);
  972.     tmps = str_get(st[2]);
  973.     if (do_open(stab,tmps,st[2]->str_cur)) {
  974.         value = (double)forkprocess;
  975.         stab_io(stab)->lines = 0;
  976.         goto donumset;
  977.     }
  978.     else if (forkprocess == 0)        /* we are a new child */
  979.         goto say_zero;
  980.     else
  981.         goto say_undef;
  982.     /* break; */
  983.     case O_TRANS:
  984.     value = (double) do_trans(str,arg);
  985.     str = arg->arg_ptr.arg_str;
  986.     goto donumset;
  987.     case O_NTRANS:
  988.     str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
  989.     str = arg->arg_ptr.arg_str;
  990.     break;
  991.     case O_CLOSE:
  992.     if (maxarg == 0)
  993.         stab = defoutstab;
  994.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  995.         stab = arg[1].arg_ptr.arg_stab;
  996.     else
  997.         stab = stabent(str_get(st[1]),TRUE);
  998.     str_set(str, do_close(stab,TRUE) ? Yes : No );
  999.     STABSET(str);
  1000.     break;
  1001.     case O_EACH:
  1002.     sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
  1003.       gimme,arglast);
  1004.     goto array_return;
  1005.     case O_VALUES:
  1006.     case O_KEYS:
  1007.     sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
  1008.       gimme,arglast);
  1009.     goto array_return;
  1010.     case O_LARRAY:
  1011.     str->str_nok = str->str_pok = 0;
  1012.     str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
  1013.     str->str_state = SS_ARY;
  1014.     break;
  1015.     case O_ARRAY:
  1016.     ary = stab_array(arg[1].arg_ptr.arg_stab);
  1017.     maxarg = ary->ary_fill + 1;
  1018.     if (gimme == G_ARRAY) { /* array wanted */
  1019.         sp = arglast[0];
  1020.         st -= sp;
  1021.         if (maxarg > 0 && sp + maxarg > stack->ary_max) {
  1022.         astore(stack,sp + maxarg, Nullstr);
  1023.         st = stack->ary_array;
  1024.         }
  1025.         st += sp;
  1026.         Copy(ary->ary_array, &st[1], maxarg, STR*);
  1027.         sp += maxarg;
  1028.         goto array_return;
  1029.     }
  1030.     else {
  1031.         value = (double)maxarg;
  1032.         goto donumset;
  1033.     }
  1034.     case O_AELEM:
  1035.     anum = ((int)str_gnum(st[2])) - arybase;
  1036.     str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
  1037.     break;
  1038.     case O_DELETE:
  1039.     tmpstab = arg[1].arg_ptr.arg_stab;
  1040.     tmps = str_get(st[2]);
  1041.     str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
  1042.     if (tmpstab == envstab)
  1043.         my_setenv(tmps,Nullch);
  1044.     if (!str)
  1045.         goto say_undef;
  1046.     break;
  1047.     case O_LHASH:
  1048.     str->str_nok = str->str_pok = 0;
  1049.     str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
  1050.     str->str_state = SS_HASH;
  1051.     break;
  1052.     case O_HASH:
  1053.     if (gimme == G_ARRAY) { /* array wanted */
  1054.         sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
  1055.         gimme,arglast);
  1056.         goto array_return;
  1057.     }
  1058.     else {
  1059.         tmpstab = arg[1].arg_ptr.arg_stab;
  1060.         if (!stab_hash(tmpstab)->tbl_fill)
  1061.         goto say_zero;
  1062.         sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
  1063.         stab_hash(tmpstab)->tbl_max+1);
  1064.         str_set(str,buf);
  1065.     }
  1066.     break;
  1067.     case O_HELEM:
  1068.     tmpstab = arg[1].arg_ptr.arg_stab;
  1069.     tmps = str_get(st[2]);
  1070.     str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
  1071.     break;
  1072.     case O_LAELEM:
  1073.     anum = ((int)str_gnum(st[2])) - arybase;
  1074.     str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
  1075.     if (!str || str == &str_undef)
  1076.         fatal("Assignment to non-creatable value, subscript %d",anum);
  1077.     break;
  1078.     case O_LHELEM:
  1079.     tmpstab = arg[1].arg_ptr.arg_stab;
  1080.     tmps = str_get(st[2]);
  1081.     anum = st[2]->str_cur;
  1082.     str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
  1083.     if (!str || str == &str_undef)
  1084.         fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
  1085.     if (tmpstab == envstab)        /* heavy wizardry going on here */
  1086.         str_magic(str, tmpstab, 'E', tmps, anum);    /* str is now magic */
  1087.                     /* he threw the brick up into the air */
  1088.     else if (tmpstab == sigstab)
  1089.         str_magic(str, tmpstab, 'S', tmps, anum);
  1090. #ifdef SOME_DBM
  1091.     else if (stab_hash(tmpstab)->tbl_dbm)
  1092.         str_magic(str, tmpstab, 'D', tmps, anum);
  1093. #endif
  1094.     else if (tmpstab == DBline)
  1095.         str_magic(str, tmpstab, 'L', tmps, anum);
  1096.     break;
  1097.     case O_LSLICE:
  1098.     anum = 2;
  1099.     argtype = FALSE;
  1100.     goto do_slice_already;
  1101.     case O_ASLICE:
  1102.     anum = 1;
  1103.     argtype = FALSE;
  1104.     goto do_slice_already;
  1105.     case O_HSLICE:
  1106.     anum = 0;
  1107.     argtype = FALSE;
  1108.     goto do_slice_already;
  1109.     case O_LASLICE:
  1110.     anum = 1;
  1111.     argtype = TRUE;
  1112.     goto do_slice_already;
  1113.     case O_LHSLICE:
  1114.     anum = 0;
  1115.     argtype = TRUE;
  1116.       do_slice_already:
  1117.     sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
  1118.         gimme,arglast);
  1119.     goto array_return;
  1120.     case O_SPLICE:
  1121.     sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast);
  1122.     goto array_return;
  1123.     case O_PUSH:
  1124.     if (arglast[2] - arglast[1] != 1)
  1125.         str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
  1126.     else {
  1127.         str = Str_new(51,0);        /* must copy the str */
  1128.         str_sset(str,st[2]);
  1129.         (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
  1130.     }
  1131.     break;
  1132.     case O_POP:
  1133.     str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
  1134.     goto staticalization;
  1135.     case O_SHIFT:
  1136.     str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
  1137.       staticalization:
  1138.     if (!str)
  1139.         goto say_undef;
  1140.     if (ary->ary_flags & ARF_REAL)
  1141.         (void)str_2mortal(str);
  1142.     break;
  1143.     case O_UNPACK:
  1144.     sp = do_unpack(str,gimme,arglast);
  1145.     goto array_return;
  1146.     case O_SPLIT:
  1147.     value = str_gnum(st[3]);
  1148.     sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
  1149.       gimme,arglast);
  1150.     goto array_return;
  1151.     case O_LENGTH:
  1152.     if (maxarg < 1)
  1153.         value = (double)str_len(stab_val(defstab));
  1154.     else
  1155.         value = (double)str_len(st[1]);
  1156.     goto donumset;
  1157.     case O_SPRINTF:
  1158.     do_sprintf(str, sp-arglast[0], st+1);
  1159.     break;
  1160.     case O_SUBSTR:
  1161.     anum = ((int)str_gnum(st[2])) - arybase;    /* anum=where to start*/
  1162.     tmps = str_get(st[1]);        /* force conversion to string */
  1163.     /*SUPPRESS 560*/
  1164.     if (argtype = (str == st[1]))
  1165.         str = arg->arg_ptr.arg_str;
  1166.     if (anum < 0)
  1167.         anum += st[1]->str_cur + arybase;
  1168.     if (anum < 0 || anum > st[1]->str_cur)
  1169.         str_nset(str,"",0);
  1170.     else {
  1171.         optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]);
  1172.         if (optype < 0)
  1173.         optype = 0;
  1174.         tmps += anum;
  1175.         anum = st[1]->str_cur - anum;    /* anum=how many bytes left*/
  1176.         if (anum > optype)
  1177.         anum = optype;
  1178.         str_nset(str, tmps, anum);
  1179.         if (argtype) {            /* it's an lvalue! */
  1180.         lstr = (struct lstring*)str;
  1181.         str->str_magic = st[1];
  1182.         st[1]->str_rare = 's';
  1183.         lstr->lstr_offset = tmps - str_get(st[1]); 
  1184.         lstr->lstr_len = anum; 
  1185.         }
  1186.     }
  1187.     break;
  1188.  
  1189.     case O_PACK:
  1190.     /*SUPPRESS 701*/
  1191.     (void)do_pack(str,arglast);
  1192.     break;
  1193.     case O_GREP:
  1194.     sp = do_grep(arg,str,gimme,arglast);
  1195.     goto array_return;
  1196.     case O_JOIN:
  1197.     do_join(str,arglast);
  1198.     break;
  1199.     case O_SLT:
  1200.     tmps = str_get(st[1]);
  1201.     value = (double) (str_cmp(st[1],st[2]) < 0);
  1202.     goto donumset;
  1203.     case O_SGT:
  1204.     tmps = str_get(st[1]);
  1205.     value = (double) (str_cmp(st[1],st[2]) > 0);
  1206.     goto donumset;
  1207.     case O_SLE:
  1208.     tmps = str_get(st[1]);
  1209.     value = (double) (str_cmp(st[1],st[2]) <= 0);
  1210.     goto donumset;
  1211.     case O_SGE:
  1212.     tmps = str_get(st[1]);
  1213.     value = (double) (str_cmp(st[1],st[2]) >= 0);
  1214.     goto donumset;
  1215.     case O_SEQ:
  1216.     tmps = str_get(st[1]);
  1217.     value = (double) str_eq(st[1],st[2]);
  1218.     goto donumset;
  1219.     case O_SNE:
  1220.     tmps = str_get(st[1]);
  1221.     value = (double) !str_eq(st[1],st[2]);
  1222.     goto donumset;
  1223.     case O_SCMP:
  1224.     tmps = str_get(st[1]);
  1225.     value = (double) str_cmp(st[1],st[2]);
  1226.     goto donumset;
  1227.     case O_SUBR:
  1228.     sp = do_subr(arg,gimme,arglast);
  1229.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1230.     goto array_return;
  1231.     case O_DBSUBR:
  1232.     sp = do_subr(arg,gimme,arglast);
  1233.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1234.     goto array_return;
  1235.     case O_CALLER:
  1236.     sp = do_caller(arg,maxarg,gimme,arglast);
  1237.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1238.     goto array_return;
  1239.     case O_SORT:
  1240.     sp = do_sort(str,arg,
  1241.       gimme,arglast);
  1242.     goto array_return;
  1243.     case O_REVERSE:
  1244.     if (gimme == G_ARRAY)
  1245.         sp = do_reverse(arglast);
  1246.     else
  1247.         sp = do_sreverse(str, arglast);
  1248.     goto array_return;
  1249.     case O_WARN:
  1250.     if (arglast[2] - arglast[1] != 1) {
  1251.         do_join(str,arglast);
  1252.         tmps = str_get(str);
  1253.     }
  1254.     else {
  1255.         str = st[2];
  1256.         tmps = str_get(st[2]);
  1257.     }
  1258.     if (!tmps || !*tmps)
  1259.         tmps = "Warning: something's wrong";
  1260.     warn("%s",tmps);
  1261.     goto say_yes;
  1262.     case O_DIE:
  1263.     if (arglast[2] - arglast[1] != 1) {
  1264.         do_join(str,arglast);
  1265.         tmps = str_get(str);
  1266.     }
  1267.     else {
  1268.         str = st[2];
  1269.         tmps = str_get(st[2]);
  1270.     }
  1271.     if (!tmps || !*tmps)
  1272.         tmps = "Died";
  1273.     fatal("%s",tmps);
  1274.     goto say_zero;
  1275.     case O_PRTF:
  1276.     case O_PRINT:
  1277.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1278.         stab = arg[1].arg_ptr.arg_stab;
  1279.     else
  1280.         stab = stabent(str_get(st[1]),TRUE);
  1281.     if (!stab)
  1282.         stab = defoutstab;
  1283.     if (!stab_io(stab)) {
  1284.         if (dowarn)
  1285.         warn("Filehandle never opened");
  1286.         goto say_zero;
  1287.     }
  1288.     if (!(fp = stab_io(stab)->ofp)) {
  1289.         if (dowarn)  {
  1290.         if (stab_io(stab)->ifp)
  1291.             warn("Filehandle opened only for input");
  1292.         else
  1293.             warn("Print on closed filehandle");
  1294.         }
  1295.         goto say_zero;
  1296.     }
  1297.     else {
  1298.         if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
  1299.         value = (double)do_aprint(arg,fp,arglast);
  1300.         else {
  1301.         value = (double)do_print(st[2],fp);
  1302.         if (orslen && optype == O_PRINT)
  1303.             if (fwrite(ors, 1, orslen, fp) == 0)
  1304.             goto say_zero;
  1305.         }
  1306.         if (stab_io(stab)->flags & IOF_FLUSH)
  1307.         if (fflush(fp) == EOF)
  1308.             goto say_zero;
  1309.     }
  1310.     goto donumset;
  1311.     case O_CHDIR:
  1312.     if (maxarg < 1)
  1313.         tmps = Nullch;
  1314.     else
  1315.         tmps = str_get(st[1]);
  1316.     if (!tmps || !*tmps) {
  1317.         tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
  1318.         tmps = str_get(tmpstr);
  1319.     }
  1320.     if (!tmps || !*tmps) {
  1321.         tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
  1322.         tmps = str_get(tmpstr);
  1323.     }
  1324.     value = (double)(chdir(tmps) >= 0);
  1325.     goto donumset;
  1326.     case O_EXIT:
  1327.     if (maxarg < 1)
  1328.         anum = 0;
  1329.     else
  1330.         anum = (int)str_gnum(st[1]);
  1331.     exit(anum);
  1332.     goto say_zero;
  1333.     case O_RESET:
  1334.     if (maxarg < 1)
  1335.         tmps = "";
  1336.     else
  1337.         tmps = str_get(st[1]);
  1338.     str_reset(tmps,curcmd->c_stash);
  1339.     value = 1.0;
  1340.     goto donumset;
  1341.     case O_LIST:
  1342.     if (gimme == G_ARRAY)
  1343.         goto array_return;
  1344.     if (maxarg > 0)
  1345.         str = st[sp - arglast[0]];    /* unwanted list, return last item */
  1346.     else
  1347.         str = &str_undef;
  1348.     break;
  1349.     case O_EOF:
  1350.     if (maxarg <= 0)
  1351.         stab = last_in_stab;
  1352.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1353.         stab = arg[1].arg_ptr.arg_stab;
  1354.     else
  1355.         stab = stabent(str_get(st[1]),TRUE);
  1356.     str_set(str, do_eof(stab) ? Yes : No);
  1357.     STABSET(str);
  1358.     break;
  1359.     case O_GETC:
  1360.     if (maxarg <= 0)
  1361.         stab = stdinstab;
  1362.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1363.         stab = arg[1].arg_ptr.arg_stab;
  1364.     else
  1365.         stab = stabent(str_get(st[1]),TRUE);
  1366.     if (!stab)
  1367.         stab = argvstab;
  1368.     if (!stab || do_eof(stab)) /* make sure we have fp with something */
  1369.         goto say_undef;
  1370.     else {
  1371.         str_set(str," ");
  1372.         *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
  1373.     }
  1374.     STABSET(str);
  1375.     break;
  1376.     case O_TELL:
  1377.     if (maxarg <= 0)
  1378.         stab = last_in_stab;
  1379.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1380.         stab = arg[1].arg_ptr.arg_stab;
  1381.     else
  1382.         stab = stabent(str_get(st[1]),TRUE);
  1383.     value = (double)do_tell(stab);
  1384.     goto donumset;
  1385.     case O_RECV:
  1386.     case O_READ:
  1387.     case O_SYSREAD:
  1388.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1389.         stab = arg[1].arg_ptr.arg_stab;
  1390.     else
  1391.         stab = stabent(str_get(st[1]),TRUE);
  1392.     tmps = str_get(st[2]);
  1393.     anum = (int)str_gnum(st[3]);
  1394.     errno = 0;
  1395.     maxarg = sp - arglast[0];
  1396.     if (maxarg > 4)
  1397.         warn("Too many args on read");
  1398.     if (maxarg == 4)
  1399.         maxarg = (int)str_gnum(st[4]);
  1400.     else
  1401.         maxarg = 0;
  1402.     if (!stab_io(stab) || !stab_io(stab)->ifp)
  1403.         goto say_undef;
  1404. #ifdef HAS_SOCKET
  1405.     if (optype == O_RECV) {
  1406.         argtype = sizeof buf;
  1407.         STR_GROW(st[2], anum+1), (tmps = str_get(st[2]));  /* sneaky */
  1408.         anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg,
  1409.         buf, &argtype);
  1410.         if (anum >= 0) {
  1411.         st[2]->str_cur = anum;
  1412.         st[2]->str_ptr[anum] = '\0';
  1413.         str_nset(str,buf,argtype);
  1414.         }
  1415.         else
  1416.         str_sset(str,&str_undef);
  1417.         break;
  1418.     }
  1419. #else
  1420.     if (optype == O_RECV)
  1421.         goto badsock;
  1422. #endif
  1423.     STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2]));  /* sneaky */
  1424.     if (optype == O_SYSREAD) {
  1425.         anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
  1426.     }
  1427.     else
  1428. #ifdef HAS_SOCKET
  1429.     if (stab_io(stab)->type == 's') {
  1430.         argtype = sizeof buf;
  1431.         anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0,
  1432.         buf, &argtype);
  1433.     }
  1434.     else
  1435. #endif
  1436.         anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
  1437.     if (anum < 0)
  1438.         goto say_undef;
  1439.     st[2]->str_cur = anum+maxarg;
  1440.     st[2]->str_ptr[anum+maxarg] = '\0';
  1441.     value = (double)anum;
  1442.     goto donumset;
  1443.     case O_SYSWRITE:
  1444.     case O_SEND:
  1445.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1446.         stab = arg[1].arg_ptr.arg_stab;
  1447.     else
  1448.         stab = stabent(str_get(st[1]),TRUE);
  1449.     tmps = str_get(st[2]);
  1450.     anum = (int)str_gnum(st[3]);
  1451.     errno = 0;
  1452.     stio = stab_io(stab);
  1453.     maxarg = sp - arglast[0];
  1454.     if (!stio || !stio->ifp) {
  1455.         anum = -1;
  1456.         if (dowarn) {
  1457.         if (optype == O_SYSWRITE)
  1458.             warn("Syswrite on closed filehandle");
  1459.         else
  1460.             warn("Send on closed socket");
  1461.         }
  1462.     }
  1463.     else if (optype == O_SYSWRITE) {
  1464.         if (maxarg > 4)
  1465.         warn("Too many args on syswrite");
  1466.         if (maxarg == 4)
  1467.         optype = (int)str_gnum(st[4]);
  1468.         else
  1469.         optype = 0;
  1470.         anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum);
  1471.     }
  1472. #ifdef HAS_SOCKET
  1473.     else if (maxarg >= 4) {
  1474.         if (maxarg > 4)
  1475.         warn("Too many args on send");
  1476.         tmps2 = str_get(st[4]);
  1477.         anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
  1478.           anum, tmps2, st[4]->str_cur);
  1479.     }
  1480.     else
  1481.         anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
  1482. #else
  1483.     else
  1484.         goto badsock;
  1485. #endif
  1486.     if (anum < 0)
  1487.         goto say_undef;
  1488.     value = (double)anum;
  1489.     goto donumset;
  1490.     case O_SEEK:
  1491.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1492.         stab = arg[1].arg_ptr.arg_stab;
  1493.     else
  1494.         stab = stabent(str_get(st[1]),TRUE);
  1495.     value = str_gnum(st[2]);
  1496.     str_set(str, do_seek(stab,
  1497.       (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
  1498.     STABSET(str);
  1499.     break;
  1500.     case O_RETURN:
  1501.     tmps = "_SUB_";        /* just fake up a "last _SUB_" */
  1502.     optype = O_LAST;
  1503.     if (curcsv && curcsv->wantarray == G_ARRAY) {
  1504.         lastretstr = Nullstr;
  1505.         lastspbase = arglast[1];
  1506.         lastsize = arglast[2] - arglast[1];
  1507.     }
  1508.     else
  1509.         lastretstr = str_mortal(st[arglast[2] - arglast[0]]);
  1510.     goto dopop;
  1511.     case O_REDO:
  1512.     case O_NEXT:
  1513.     case O_LAST:
  1514.     tmps = Nullch;
  1515.     if (maxarg > 0) {
  1516.         tmps = str_get(arg[1].arg_ptr.arg_str);
  1517.       dopop:
  1518.         while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
  1519.           strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
  1520. #ifdef DEBUGGING
  1521.         if (debug & 4) {
  1522.             deb("(Skipping label #%d %s)\n",loop_ptr,
  1523.             loop_stack[loop_ptr].loop_label);
  1524.         }
  1525. #endif
  1526.         loop_ptr--;
  1527.         }
  1528. #ifdef DEBUGGING
  1529.         if (debug & 4) {
  1530.         deb("(Found label #%d %s)\n",loop_ptr,
  1531.             loop_stack[loop_ptr].loop_label);
  1532.         }
  1533. #endif
  1534.     }
  1535.     if (loop_ptr < 0) {
  1536.         if (tmps && strEQ(tmps, "_SUB_"))
  1537.         fatal("Can't return outside a subroutine");
  1538.         fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
  1539.     }
  1540.     if (!lastretstr && optype == O_LAST && lastsize) {
  1541.         st -= arglast[0];
  1542.         st += lastspbase + 1;
  1543.         optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
  1544.         if (optype) {
  1545.         for (anum = lastsize; anum > 0; anum--,st++)
  1546.             st[optype] = str_mortal(st[0]);
  1547.         }
  1548.         longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
  1549.     }
  1550.     longjmp(loop_stack[loop_ptr].loop_env, optype);
  1551.     case O_DUMP:
  1552.     case O_GOTO:/* shudder */
  1553.     goto_targ = str_get(arg[1].arg_ptr.arg_str);
  1554.     if (!*goto_targ)
  1555.         goto_targ = Nullch;        /* just restart from top */
  1556.     if (optype == O_DUMP) {
  1557.         do_undump = 1;
  1558.         my_unexec();
  1559.     }
  1560.     longjmp(top_env, 1);
  1561.     case O_INDEX:
  1562.     tmps = str_get(st[1]);
  1563.     if (maxarg < 3)
  1564.         anum = 0;
  1565.     else {
  1566.         anum = (int) str_gnum(st[3]) - arybase;
  1567.         if (anum < 0)
  1568.         anum = 0;
  1569.         else if (anum > st[1]->str_cur)
  1570.         anum = st[1]->str_cur;
  1571.     }
  1572.     if (!(tmps2 = fbminstr((unsigned char*)tmps + anum,
  1573.       (unsigned char*)tmps + st[1]->str_cur, st[2])))
  1574.         value = (double)(-1 + arybase);
  1575.     else
  1576.         value = (double)(tmps2 - tmps + arybase);
  1577.     goto donumset;
  1578.     case O_RINDEX:
  1579.     tmps = str_get(st[1]);
  1580.     tmps2 = str_get(st[2]);
  1581.     if (maxarg < 3)
  1582.         anum = st[1]->str_cur;
  1583.     else {
  1584.         anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur;
  1585.         if (anum < 0)
  1586.         anum = 0;
  1587.         else if (anum > st[1]->str_cur)
  1588.         anum = st[1]->str_cur;
  1589.     }
  1590.     if (!(tmps2 = rninstr(tmps,  tmps  + anum,
  1591.                   tmps2, tmps2 + st[2]->str_cur)))
  1592.         value = (double)(-1 + arybase);
  1593.     else
  1594.         value = (double)(tmps2 - tmps + arybase);
  1595.     goto donumset;
  1596.     case O_TIME:
  1597.     value = (double) time(Null(time_t*));
  1598.     goto donumset;
  1599.     case O_TMS:
  1600.     sp = do_tms(str,gimme,arglast);
  1601.     goto array_return;
  1602.     case O_LOCALTIME:
  1603.     if (maxarg < 1)
  1604.         (void)time(&when);
  1605.     else
  1606.         when = (time_t)str_gnum(st[1]);
  1607.     sp = do_time(str,localtime(&when),
  1608.       gimme,arglast);
  1609.     goto array_return;
  1610.     case O_GMTIME:
  1611.     if (maxarg < 1)
  1612.         (void)time(&when);
  1613.     else
  1614.         when = (time_t)str_gnum(st[1]);
  1615.     sp = do_time(str,gmtime(&when),
  1616.       gimme,arglast);
  1617.     goto array_return;
  1618.     case O_TRUNCATE:
  1619.     sp = do_truncate(str,arg,
  1620.       gimme,arglast);
  1621.     goto array_return;
  1622.     case O_LSTAT:
  1623.     case O_STAT:
  1624.     sp = do_stat(str,arg,
  1625.       gimme,arglast);
  1626.     goto array_return;
  1627.     case O_CRYPT:
  1628. #ifdef HAS_CRYPT
  1629.     tmps = str_get(st[1]);
  1630. #ifdef FCRYPT
  1631.     str_set(str,fcrypt(tmps,str_get(st[2])));
  1632. #else
  1633.     str_set(str,crypt(tmps,str_get(st[2])));
  1634. #endif
  1635. #else
  1636.     fatal(
  1637.       "The crypt() function is unimplemented due to excessive paranoia.");
  1638. #endif
  1639.     break;
  1640.     case O_ATAN2:
  1641.     value = str_gnum(st[1]);
  1642.     value = atan2(value,str_gnum(st[2]));
  1643.     goto donumset;
  1644.     case O_SIN:
  1645.     if (maxarg < 1)
  1646.         value = str_gnum(stab_val(defstab));
  1647.     else
  1648.         value = str_gnum(st[1]);
  1649.     value = sin(value);
  1650.     goto donumset;
  1651.     case O_COS:
  1652.     if (maxarg < 1)
  1653.         value = str_gnum(stab_val(defstab));
  1654.     else
  1655.         value = str_gnum(st[1]);
  1656.     value = cos(value);
  1657.     goto donumset;
  1658.     case O_RAND:
  1659.     if (maxarg < 1)
  1660.         value = 1.0;
  1661.     else
  1662.         value = str_gnum(st[1]);
  1663.     if (value == 0.0)
  1664.         value = 1.0;
  1665. #if RANDBITS == 31
  1666.     value = rand() * value / 2147483648.0;
  1667. #else
  1668. #if RANDBITS == 16
  1669.     value = rand() * value / 65536.0;
  1670. #else
  1671. #if RANDBITS == 15
  1672.     value = rand() * value / 32768.0;
  1673. #else
  1674.     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
  1675. #endif
  1676. #endif
  1677. #endif
  1678.     goto donumset;
  1679.     case O_SRAND:
  1680. #ifdef macintosh
  1681.     if (maxarg < 1) {
  1682.         (void)time(&when);
  1683.     }
  1684.     else
  1685.         when = (time_t)str_gnum(st[1]);
  1686.     srand(when);
  1687. #else
  1688.     if (maxarg < 1) {
  1689.         (void)time(&when);
  1690.         anum = when;
  1691.     }
  1692.     else
  1693.         anum = (int)str_gnum(st[1]);
  1694.     srand(anum);
  1695. #endif
  1696.     goto say_yes;
  1697.     case O_EXP:
  1698.     if (maxarg < 1)
  1699.         value = str_gnum(stab_val(defstab));
  1700.     else
  1701.         value = str_gnum(st[1]);
  1702.     value = exp(value);
  1703.     goto donumset;
  1704.     case O_LOG:
  1705.     if (maxarg < 1)
  1706.         value = str_gnum(stab_val(defstab));
  1707.     else
  1708.         value = str_gnum(st[1]);
  1709.     if (value <= 0.0)
  1710.         fatal("Can't take log of %g\n", value);
  1711.     value = log(value);
  1712.     goto donumset;
  1713.     case O_SQRT:
  1714.     if (maxarg < 1)
  1715.         value = str_gnum(stab_val(defstab));
  1716.     else
  1717.         value = str_gnum(st[1]);
  1718.     if (value < 0.0)
  1719.         fatal("Can't take sqrt of %g\n", value);
  1720.     value = sqrt(value);
  1721.     goto donumset;
  1722.     case O_INT:
  1723.     if (maxarg < 1)
  1724.         value = str_gnum(stab_val(defstab));
  1725.     else
  1726.         value = str_gnum(st[1]);
  1727.     {
  1728. #if defined(powerc) || defined(__powerc)
  1729.         if (value >= 0.0)
  1730.             (void)modf(value,&value);
  1731.         else {
  1732.             (void)modf(-value,&value);
  1733.             value = -value;
  1734.         }
  1735. #else
  1736.          extended    intpart;
  1737.         
  1738.         if (value >= 0.0)
  1739.             (void)modf(value,&intpart);
  1740.         else {
  1741.             (void)modf(-value,&intpart);
  1742.             intpart = -intpart;
  1743.         }
  1744.         
  1745.         value = intpart;
  1746. #endif
  1747.     }
  1748.     goto donumset;
  1749.     case O_ORD:
  1750.     if (maxarg < 1)
  1751.         tmps = str_get(stab_val(defstab));
  1752.     else
  1753.         tmps = str_get(st[1]);
  1754.     value = (double) (*tmps & 255);
  1755.     goto donumset;
  1756.     case O_ALARM:
  1757. #ifdef HAS_ALARM
  1758.     if (maxarg < 1)
  1759.         tmps = str_get(stab_val(defstab));
  1760.     else
  1761.         tmps = str_get(st[1]);
  1762.     if (!tmps)
  1763.         tmps = "0";
  1764.     anum = alarm((unsigned int)atoi(tmps));
  1765.     if (anum < 0)
  1766.         goto say_undef;
  1767.     value = (double)anum;
  1768.     goto donumset;
  1769. #else
  1770.     fatal("Unsupported function alarm");
  1771.     break;
  1772. #endif
  1773.     case O_SLEEP:
  1774.     if (maxarg < 1)
  1775.         tmps = Nullch;
  1776.     else
  1777.         tmps = str_get(st[1]);
  1778.     (void)time(&when);
  1779.     if (!tmps || !*tmps)
  1780.         sleep((32767<<16)+32767);
  1781.     else
  1782.         sleep((unsigned int)atoi(tmps));
  1783.     value = (double)when;
  1784.     (void)time(&when);
  1785.     value = ((double)when) - value;
  1786.     goto donumset;
  1787.     case O_RANGE:
  1788.     sp = do_range(gimme,arglast);
  1789.     goto array_return;
  1790.     case O_F_OR_R:
  1791.     if (gimme == G_ARRAY) {        /* it's a range */
  1792.         /* can we optimize to constant array? */
  1793.         if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
  1794.           (arg[2].arg_type & A_MASK) == A_SINGLE) {
  1795.         st[2] = arg[2].arg_ptr.arg_str;
  1796.         sp = do_range(gimme,arglast);
  1797.         st = stack->ary_array;
  1798.         maxarg = sp - arglast[0];
  1799.         str_free(arg[1].arg_ptr.arg_str);
  1800.         arg[1].arg_ptr.arg_str = Nullstr;
  1801.         str_free(arg[2].arg_ptr.arg_str);
  1802.         arg[2].arg_ptr.arg_str = Nullstr;
  1803.         arg->arg_type = O_ARRAY;
  1804.         arg[1].arg_type = A_STAB|A_DONT;
  1805.         arg->arg_len = 1;
  1806.         stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
  1807.         ary = stab_array(stab);
  1808.         afill(ary,maxarg - 1);
  1809.         anum = maxarg;
  1810.         st += arglast[0]+1;
  1811.         while (maxarg-- > 0)
  1812.             ary->ary_array[maxarg] = str_smake(st[maxarg]);
  1813.         st -= arglast[0]+1;
  1814.         goto array_return;
  1815.         }
  1816.         arg->arg_type = optype = O_RANGE;
  1817.         maxarg = arg->arg_len = 2;
  1818.         anum = 2;
  1819.         arg[anum].arg_flags &= ~AF_ARYOK;
  1820.         argflags = arg[anum].arg_flags;
  1821.         argtype = arg[anum].arg_type & A_MASK;
  1822.         arg[anum].arg_type = argtype;
  1823.         argptr = arg[anum].arg_ptr;
  1824.         sp = arglast[0];
  1825.         st -= sp;
  1826.         sp++;
  1827.         goto re_eval;
  1828.     }
  1829.     arg->arg_type = O_FLIP;
  1830.     /* FALL THROUGH */
  1831.     case O_FLIP:
  1832.     if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
  1833.       last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
  1834.       :
  1835.       str_true(st[1]) ) {
  1836.         arg[2].arg_type &= ~A_DONT;
  1837.         arg[1].arg_type |= A_DONT;
  1838.         arg->arg_type = optype = O_FLOP;
  1839.         if (arg->arg_flags & AF_COMMON) {
  1840.         str_numset(str,0.0);
  1841.         anum = 2;
  1842.         argflags = arg[2].arg_flags;
  1843.         argtype = arg[2].arg_type & A_MASK;
  1844.         argptr = arg[2].arg_ptr;
  1845.         sp = arglast[0];
  1846.         st -= sp++;
  1847.         goto re_eval;
  1848.         }
  1849.         else {
  1850.         str_numset(str,1.0);
  1851.         break;
  1852.         }
  1853.     }
  1854.     str_set(str,"");
  1855.     break;
  1856.     case O_FLOP:
  1857.     str_inc(str);
  1858.     if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
  1859.       last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
  1860.       :
  1861.       str_true(st[2]) ) {
  1862.         arg->arg_type = O_FLIP;
  1863.         arg[1].arg_type &= ~A_DONT;
  1864.         arg[2].arg_type |= A_DONT;
  1865.         str_cat(str,"E0");
  1866.     }
  1867.     break;
  1868.     case O_FORK:
  1869.     fatal("Unsupported function fork");
  1870.     break;
  1871.     case O_WAIT:
  1872.     fatal("Unsupported function wait");
  1873.     break;
  1874.     case O_WAITPID:
  1875.     fatal("Unsupported function wait");
  1876.     break;
  1877.     case O_SYSTEM:
  1878.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1879.         value = (double)do_aspawn(st[1],arglast);
  1880.     else if (arglast[2] - arglast[1] != 1)
  1881.         value = (double)do_aspawn(Nullstr,arglast);
  1882.     else {
  1883.         value = (double)do_spawn(str_get(str_mortal(st[2])));
  1884.     }
  1885.     goto donumset;
  1886.     case O_EXEC_OP:
  1887.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1888.         value = (double)do_aexec(st[1],arglast);
  1889.     else if (arglast[2] - arglast[1] != 1)
  1890.         value = (double)do_aexec(Nullstr,arglast);
  1891.     else {
  1892.         value = (double)do_exec(str_get(str_mortal(st[2])));
  1893.     }
  1894.     goto donumset;
  1895.     case O_HEX:
  1896.     if (maxarg < 1)
  1897.         tmps = str_get(stab_val(defstab));
  1898.     else
  1899.         tmps = str_get(st[1]);
  1900.     value = (double)scanhex(tmps, 99, &argtype);
  1901.     goto donumset;
  1902.  
  1903.     case O_OCT:
  1904.     if (maxarg < 1)
  1905.         tmps = str_get(stab_val(defstab));
  1906.     else
  1907.         tmps = str_get(st[1]);
  1908.     while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
  1909.         tmps++;
  1910.     if (*tmps == 'x')
  1911.         value = (double)scanhex(++tmps, 99, &argtype);
  1912.     else
  1913.         value = (double)scanoct(tmps, 99, &argtype);
  1914.     goto donumset;
  1915.     case O_CHOWN:
  1916. #ifdef HAS_CHOWN
  1917.     value = (double)apply(optype,arglast);
  1918.     goto donumset;
  1919. #else
  1920.     fatal("Unsupported function chown");
  1921.     break;
  1922. #endif
  1923.     case O_KILL:
  1924.     fatal("Unsupported function kill");
  1925.     break;
  1926.     case O_UNLINK:
  1927.     case O_CHMOD:
  1928.     case O_UTIME:
  1929.     value = (double)apply(optype,arglast);
  1930.     goto donumset;
  1931.     case O_UMASK:
  1932.     fatal("Unsupported function umask");
  1933.     break;
  1934. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  1935.     case O_MSGGET:
  1936.     case O_SHMGET:
  1937.     case O_SEMGET:
  1938.     if ((anum = do_ipcget(optype, arglast)) == -1)
  1939.         goto say_undef;
  1940.     value = (double)anum;
  1941.     goto donumset;
  1942.     case O_MSGCTL:
  1943.     case O_SHMCTL:
  1944.     case O_SEMCTL:
  1945.     anum = do_ipcctl(optype, arglast);
  1946.     if (anum == -1)
  1947.         goto say_undef;
  1948.     if (anum != 0) {
  1949.         value = (double)anum;
  1950.         goto donumset;
  1951.     }
  1952.     str_set(str,"0 but true");
  1953.     STABSET(str);
  1954.     break;
  1955.     case O_MSGSND:
  1956.     value = (double)(do_msgsnd(arglast) >= 0);
  1957.     goto donumset;
  1958.     case O_MSGRCV:
  1959.     value = (double)(do_msgrcv(arglast) >= 0);
  1960.     goto donumset;
  1961.     case O_SEMOP:
  1962.     value = (double)(do_semop(arglast) >= 0);
  1963.     goto donumset;
  1964.     case O_SHMREAD:
  1965.     case O_SHMWRITE:
  1966.     value = (double)(do_shmio(optype, arglast) >= 0);
  1967.     goto donumset;
  1968. #else /* not SYSVIPC */
  1969.     case O_MSGGET:
  1970.     case O_MSGCTL:
  1971.     case O_MSGSND:
  1972.     case O_MSGRCV:
  1973.     case O_SEMGET:
  1974.     case O_SEMCTL:
  1975.     case O_SEMOP:
  1976.     case O_SHMGET:
  1977.     case O_SHMCTL:
  1978.     case O_SHMREAD:
  1979.     case O_SHMWRITE:
  1980.     fatal("System V IPC is not implemented on this machine");
  1981. #endif /* not SYSVIPC */
  1982.     case O_RENAME:
  1983.     tmps = str_get(st[1]);
  1984.     tmps2 = str_get(st[2]);
  1985.     value = (double)(rename(tmps,tmps2) >= 0);
  1986.     goto donumset;
  1987.     case O_LINK:
  1988.     fatal("Unsupported function link");
  1989.     break;
  1990.     case O_MKDIR:
  1991.     tmps = str_get(st[1]);
  1992.     anum = (int)str_gnum(st[2]);
  1993.     value = (double)(mkdir(tmps) >= 0);
  1994.     goto donumset;
  1995.     case O_RMDIR:
  1996.     if (maxarg < 1)
  1997.         tmps = str_get(stab_val(defstab));
  1998.     else
  1999.         tmps = str_get(st[1]);
  2000.     value = (double)(rmdir(tmps) >= 0);
  2001.     goto donumset;
  2002.     case O_GETPPID:
  2003.     fatal("Unsupported function getppid");
  2004.     break;
  2005.     case O_GETPGRP:
  2006.     fatal("The getpgrp() function is unimplemented on this machine");
  2007.     break;
  2008.     case O_SETPGRP:
  2009.     fatal("The setpgrp() function is unimplemented on this machine");
  2010.     break;
  2011.     case O_GETPRIORITY:
  2012.     fatal("The getpriority() function is unimplemented on this machine");
  2013.     break;
  2014.     case O_SETPRIORITY:
  2015.     fatal("The setpriority() function is unimplemented on this machine");
  2016.     break;
  2017.     case O_CHROOT:
  2018.     fatal("Unsupported function chroot");
  2019.     break;
  2020.     case O_FCNTL:
  2021.     case O_IOCTL:
  2022.     if (maxarg <= 0)
  2023.         stab = last_in_stab;
  2024.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  2025.         stab = arg[1].arg_ptr.arg_stab;
  2026.     else
  2027.         stab = stabent(str_get(st[1]),TRUE);
  2028.     argtype = U_I(str_gnum(st[2]));
  2029.     anum = do_ctl(optype,stab,argtype,st[3]);
  2030.     if (anum == -1)
  2031.         goto say_undef;
  2032.     if (anum != 0) {
  2033.         value = (double)anum;
  2034.         goto donumset;
  2035.     }
  2036.     str_set(str,"0 but true");
  2037.     STABSET(str);
  2038.     break;
  2039.     case O_FLOCK:
  2040. #ifdef HAS_FLOCK
  2041.     if (maxarg <= 0)
  2042.         stab = last_in_stab;
  2043.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  2044.         stab = arg[1].arg_ptr.arg_stab;
  2045.     else
  2046.         stab = stabent(str_get(st[1]),TRUE);
  2047.     if (stab && stab_io(stab))
  2048.         fp = stab_io(stab)->ifp;
  2049.     else
  2050.         fp = Nullfp;
  2051.     if (fp) {
  2052.         argtype = (int)str_gnum(st[2]);
  2053.         value = (double)(flock(fileno(fp),argtype) >= 0);
  2054.     }
  2055.     else
  2056.         value = 0;
  2057.     goto donumset;
  2058. #else
  2059.     fatal("The flock() function is unimplemented on this machine");
  2060.     break;
  2061. #endif
  2062.     case O_UNSHIFT:
  2063.     ary = stab_array(arg[1].arg_ptr.arg_stab);
  2064.     if (arglast[2] - arglast[1] != 1)
  2065.         do_unshift(ary,arglast);
  2066.     else {
  2067.         STR *    tmpstr = Str_new(52,0);    /* must copy the str */
  2068.         str_sset(tmpstr,st[2]);
  2069.         aunshift(ary,1);
  2070.         (void)astore(ary,0,tmpstr);
  2071.     }
  2072.     value = (double)(ary->ary_fill + 1);
  2073.     goto donumset;
  2074.  
  2075.     case O_TRY:
  2076.     sp = do_try(arg[1].arg_ptr.arg_cmd,
  2077.         gimme,arglast);
  2078.     goto array_return;
  2079.  
  2080.     case O_EVALONCE:
  2081.     sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE,
  2082.         gimme,arglast);
  2083.     if (eval_root) {
  2084.         str_free(arg[1].arg_ptr.arg_str);
  2085.         arg[1].arg_ptr.arg_cmd = eval_root;
  2086.         arg[1].arg_type = (A_CMD|A_DONT);
  2087.         arg[0].arg_type = O_TRY;
  2088.     }
  2089.     goto array_return;
  2090.  
  2091.     case O_REQUIRE:
  2092.     case O_DOFILE:
  2093.     case O_EVAL:
  2094.     if (maxarg < 1)
  2095.         tmpstr = stab_val(defstab);
  2096.     else
  2097.         tmpstr =
  2098.           (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
  2099.     sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE,
  2100.         gimme,arglast);
  2101.     goto array_return;
  2102.  
  2103.     case O_FTRREAD:
  2104.     argtype = 0;
  2105.     anum = S_IRUSR;
  2106.     goto check_perm;
  2107.     case O_FTRWRITE:
  2108.     argtype = 0;
  2109.     anum = S_IWUSR;
  2110.     goto check_perm;
  2111.     case O_FTREXEC:
  2112.     argtype = 0;
  2113.     anum = S_IXUSR;
  2114.     goto check_perm;
  2115.     case O_FTEREAD:
  2116.     argtype = 1;
  2117.     anum = S_IRUSR;
  2118.     goto check_perm;
  2119.     case O_FTEWRITE:
  2120.     argtype = 1;
  2121.     anum = S_IWUSR;
  2122.     goto check_perm;
  2123.     case O_FTEEXEC:
  2124.     argtype = 1;
  2125.     anum = S_IXUSR;
  2126.       check_perm:
  2127.     if (mystat(arg,st[1]) < 0)
  2128.         goto say_undef;
  2129.     if (cando(anum,argtype,&statcache))
  2130.         goto say_yes;
  2131.     goto say_no;
  2132.  
  2133.     case O_FTIS:
  2134.     if (mystat(arg,st[1]) < 0)
  2135.         goto say_undef;
  2136.     goto say_yes;
  2137.     case O_FTEOWNED:
  2138.     case O_FTROWNED:
  2139.     if (mystat(arg,st[1]) < 0)
  2140.         goto say_undef;
  2141.     else
  2142.         goto say_yes;
  2143.     case O_FTZERO:
  2144.     if (mystat(arg,st[1]) < 0)
  2145.         goto say_undef;
  2146.     if (!statcache.st_size)
  2147.         goto say_yes;
  2148.     goto say_no;
  2149.     case O_FTSIZE:
  2150.     if (mystat(arg,st[1]) < 0)
  2151.         goto say_undef;
  2152.     value = (double)statcache.st_size;
  2153.     goto donumset;
  2154.  
  2155.     case O_FTMTIME:
  2156.     if (mystat(arg,st[1]) < 0)
  2157.         goto say_undef;
  2158.     value = (double)(basetime - statcache.st_mtime) / 86400.0;
  2159.     goto donumset;
  2160.     case O_FTATIME:
  2161.     if (mystat(arg,st[1]) < 0)
  2162.         goto say_undef;
  2163.     value = (double)(basetime - statcache.st_atime) / 86400.0;
  2164.     goto donumset;
  2165.     case O_FTCTIME:
  2166.     if (mystat(arg,st[1]) < 0)
  2167.         goto say_undef;
  2168.     value = (double)(basetime - statcache.st_ctime) / 86400.0;
  2169.     goto donumset;
  2170.  
  2171.     case O_FTSOCK:
  2172.     if (mystat(arg,st[1]) < 0)
  2173.         goto say_undef;
  2174.     if (S_ISSOCK(statcache.st_mode))
  2175.         goto say_yes;
  2176.     goto say_no;
  2177.     case O_FTCHR:
  2178.     if (mystat(arg,st[1]) < 0)
  2179.         goto say_undef;
  2180.     if (S_ISCHR(statcache.st_mode))
  2181.         goto say_yes;
  2182.     goto say_no;
  2183.     case O_FTBLK:
  2184.     if (mystat(arg,st[1]) < 0)
  2185.         goto say_undef;
  2186.     if (S_ISBLK(statcache.st_mode))
  2187.         goto say_yes;
  2188.     goto say_no;
  2189.     case O_FTFILE:
  2190.     if (mystat(arg,st[1]) < 0)
  2191.         goto say_undef;
  2192.     if (S_ISREG(statcache.st_mode))
  2193.         goto say_yes;
  2194.     goto say_no;
  2195.     case O_FTDIR:
  2196.     if (mystat(arg,st[1]) < 0)
  2197.         goto say_undef;
  2198.     if (S_ISDIR(statcache.st_mode))
  2199.         goto say_yes;
  2200.     goto say_no;
  2201.     case O_FTPIPE:
  2202.     if (mystat(arg,st[1]) < 0)
  2203.         goto say_undef;
  2204.     if (S_ISFIFO(statcache.st_mode))
  2205.         goto say_yes;
  2206.     goto say_no;
  2207.     case O_FTLINK:
  2208.     if (mylstat(arg,st[1]) < 0)
  2209.         goto say_undef;
  2210.     if (S_ISLNK(statcache.st_mode))
  2211.         goto say_yes;
  2212.     goto say_no;
  2213.     case O_SYMLINK:
  2214. #ifdef HAS_SYMLINK
  2215.     tmps = str_get(st[1]);
  2216.     tmps2 = str_get(st[2]);
  2217.     value = (double)(symlink(tmps,tmps2) >= 0);
  2218.     goto donumset;
  2219. #else
  2220.     fatal("Unsupported function symlink");
  2221. #endif
  2222.     case O_READLINK:
  2223. #ifdef HAS_SYMLINK
  2224.     if (maxarg < 1)
  2225.         tmps = str_get(stab_val(defstab));
  2226.     else
  2227.         tmps = str_get(st[1]);
  2228.     anum = readlink(tmps,buf,sizeof buf);
  2229.     if (anum < 0)
  2230.         goto say_undef;
  2231.     str_nset(str,buf,anum);
  2232.     break;
  2233. #else
  2234.     goto say_undef;        /* just pretend it's a normal file */
  2235. #endif
  2236.     case O_FTSUID:
  2237. #ifdef S_ISUID
  2238.     anum = S_ISUID;
  2239.     goto check_xid;
  2240. #else
  2241.     goto say_no;
  2242. #endif
  2243.     case O_FTSGID:
  2244. #ifdef S_ISGID
  2245.     anum = S_ISGID;
  2246.     goto check_xid;
  2247. #else
  2248.     goto say_no;
  2249. #endif
  2250.     case O_FTSVTX:
  2251. #ifdef S_ISVTX
  2252.     anum = S_ISVTX;
  2253. #else
  2254.     goto say_no;
  2255. #endif
  2256.       check_xid:
  2257.     if (mystat(arg,st[1]) < 0)
  2258.         goto say_undef;
  2259.     if (statcache.st_mode & anum)
  2260.         goto say_yes;
  2261.     goto say_no;
  2262.     case O_FTTTY:
  2263.     if (arg[1].arg_type & A_DONT) {
  2264.         stab = arg[1].arg_ptr.arg_stab;
  2265.         tmps = "";
  2266.     }
  2267.     else
  2268.         stab = stabent(tmps = str_get(st[1]),FALSE);
  2269.     if (stab && stab_io(stab) && stab_io(stab)->ifp)
  2270.         anum = fileno(stab_io(stab)->ifp);
  2271.     else if (isDIGIT(*tmps))
  2272.         anum = atoi(tmps);
  2273.     else
  2274.         goto say_undef;
  2275.     if (isatty(anum))
  2276.         goto say_yes;
  2277.     goto say_no;
  2278.     case O_FTTEXT:
  2279.     case O_FTBINARY:
  2280.     str = do_fttext(arg,st[1]);
  2281.     break;
  2282. #ifdef HAS_SOCKET
  2283.     case O_SOCKET:
  2284.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2285.         stab = arg[1].arg_ptr.arg_stab;
  2286.     else
  2287.         stab = stabent(str_get(st[1]),TRUE);
  2288.     value = (double)do_socket(stab,arglast);
  2289.     goto donumset;
  2290.     case O_BIND:
  2291.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2292.         stab = arg[1].arg_ptr.arg_stab;
  2293.     else
  2294.         stab = stabent(str_get(st[1]),TRUE);
  2295.     value = (double)do_bind(stab,arglast);
  2296.     goto donumset;
  2297.     case O_CONNECT:
  2298.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2299.         stab = arg[1].arg_ptr.arg_stab;
  2300.     else
  2301.         stab = stabent(str_get(st[1]),TRUE);
  2302.     value = (double)do_connect(stab,arglast);
  2303.     goto donumset;
  2304.     case O_LISTEN:
  2305.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2306.         stab = arg[1].arg_ptr.arg_stab;
  2307.     else
  2308.         stab = stabent(str_get(st[1]),TRUE);
  2309.     value = (double)do_listen(stab,arglast);
  2310.     goto donumset;
  2311.     case O_ACCEPT:
  2312.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2313.         stab = arg[1].arg_ptr.arg_stab;
  2314.     else
  2315.         stab = stabent(str_get(st[1]),TRUE);
  2316.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2317.         stab2 = arg[2].arg_ptr.arg_stab;
  2318.     else
  2319.         stab2 = stabent(str_get(st[2]),TRUE);
  2320.     do_accept(str,stab,stab2);
  2321.     STABSET(str);
  2322.     break;
  2323.     case O_GHBYNAME:
  2324.     if (maxarg < 1)
  2325.         goto say_undef;
  2326.     case O_GHBYADDR:
  2327.     case O_GHOSTENT:
  2328.     sp = do_ghent(optype,
  2329.       gimme,arglast);
  2330.     goto array_return;
  2331. #ifndef macintosh
  2332.     case O_GNBYNAME:
  2333.     if (maxarg < 1)
  2334.         goto say_undef;
  2335.     case O_GNBYADDR:
  2336.     case O_GNETENT:
  2337.     sp = do_gnent(optype,
  2338.       gimme,arglast);
  2339.     goto array_return;
  2340. #else
  2341.     case O_GNBYNAME:
  2342.     case O_GNBYADDR:
  2343.     case O_GNETENT:
  2344.     fatal("getnet╔() not implemented");
  2345. #endif
  2346.     case O_GPBYNAME:
  2347.     if (maxarg < 1)
  2348.         goto say_undef;
  2349.     case O_GPBYNUMBER:
  2350.     case O_GPROTOENT:
  2351.     sp = do_gpent(optype,
  2352.       gimme,arglast);
  2353.     goto array_return;
  2354.     case O_GSBYNAME:
  2355.     if (maxarg < 1)
  2356.         goto say_undef;
  2357.     case O_GSBYPORT:
  2358.     case O_GSERVENT:
  2359.     sp = do_gsent(optype,
  2360.       gimme,arglast);
  2361.     goto array_return;
  2362. #ifndef macintosh
  2363.     case O_SHOSTENT:
  2364.     value = (double) sethostent((int)str_gnum(st[1]));
  2365.     goto donumset;
  2366.     case O_SNETENT:
  2367.     value = (double) setnetent((int)str_gnum(st[1]));
  2368.     goto donumset;
  2369.     case O_SPROTOENT:
  2370.     value = (double) setprotoent((int)str_gnum(st[1]));
  2371.     goto donumset;
  2372.     case O_SSERVENT:
  2373.     value = (double) setservent((int)str_gnum(st[1]));
  2374.     goto donumset;
  2375. #else
  2376.     case O_SHOSTENT:
  2377.     case O_SNETENT:
  2378.     case O_SPROTOENT:
  2379.     case O_SSERVENT:
  2380.     fatal("set╔() not implemented");
  2381. #endif
  2382. #ifndef macintosh
  2383.     case O_EHOSTENT:
  2384.     value = (double) endhostent();
  2385.     goto donumset;
  2386.     case O_ENETENT:
  2387.     value = (double) endnetent();
  2388.     goto donumset;
  2389.     case O_EPROTOENT:
  2390.     value = (double) endprotoent();
  2391.     goto donumset;
  2392.     case O_ESERVENT:
  2393.     value = (double) endservent();
  2394.     goto donumset;
  2395. #else
  2396.     case O_EHOSTENT:
  2397.     case O_ENETENT:
  2398.     case O_EPROTOENT:
  2399.     case O_ESERVENT:
  2400.     fatal("end╔() not implemented");
  2401. #endif
  2402. #ifndef macintosh
  2403.     case O_SOCKPAIR:
  2404.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2405.         stab = arg[1].arg_ptr.arg_stab;
  2406.     else
  2407.         stab = stabent(str_get(st[1]),TRUE);
  2408.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2409.         stab2 = arg[2].arg_ptr.arg_stab;
  2410.     else
  2411.         stab2 = stabent(str_get(st[2]),TRUE);
  2412.     value = (double)do_spair(stab,stab2,arglast);
  2413.     goto donumset;
  2414. #else
  2415.     case O_SOCKPAIR:
  2416.         fatal("socketpair() not implemented");
  2417. #endif
  2418.     case O_SHUTDOWN:
  2419.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2420.         stab = arg[1].arg_ptr.arg_stab;
  2421.     else
  2422.         stab = stabent(str_get(st[1]),TRUE);
  2423.     value = (double)do_shutdown(stab,arglast);
  2424.     goto donumset;
  2425.     case O_GSOCKOPT:
  2426.     case O_SSOCKOPT:
  2427.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2428.         stab = arg[1].arg_ptr.arg_stab;
  2429.     else
  2430.         stab = stabent(str_get(st[1]),TRUE);
  2431.     sp = do_sopt(optype,stab,arglast);
  2432.     goto array_return;
  2433.     case O_GETSOCKNAME:
  2434.     case O_GETPEERNAME:
  2435.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2436.         stab = arg[1].arg_ptr.arg_stab;
  2437.     else
  2438.         stab = stabent(str_get(st[1]),TRUE);
  2439.     if (!stab)
  2440.         goto say_undef;
  2441.     sp = do_getsockname(optype,stab,arglast);
  2442.     goto array_return;
  2443.  
  2444. #ifdef macintosh
  2445.     case O_CHOOSE:
  2446.     str = do_choose(arglast, maxarg);
  2447.     break;
  2448. #endif
  2449.  
  2450. #else /* HAS_SOCKET not defined */
  2451.     case O_SOCKET:
  2452.     case O_BIND:
  2453.     case O_CONNECT:
  2454.     case O_LISTEN:
  2455.     case O_ACCEPT:
  2456.     case O_SOCKPAIR:
  2457.     case O_GHBYNAME:
  2458.     case O_GHBYADDR:
  2459.     case O_GHOSTENT:
  2460.     case O_GNBYNAME:
  2461.     case O_GNBYADDR:
  2462.     case O_GNETENT:
  2463.     case O_GPBYNAME:
  2464.     case O_GPBYNUMBER:
  2465.     case O_GPROTOENT:
  2466.     case O_GSBYNAME:
  2467.     case O_GSBYPORT:
  2468.     case O_GSERVENT:
  2469.     case O_SHOSTENT:
  2470.     case O_SNETENT:
  2471.     case O_SPROTOENT:
  2472.     case O_SSERVENT:
  2473.     case O_EHOSTENT:
  2474.     case O_ENETENT:
  2475.     case O_EPROTOENT:
  2476.     case O_ESERVENT:
  2477.     case O_SHUTDOWN:
  2478.     case O_GSOCKOPT:
  2479.     case O_SSOCKOPT:
  2480.     case O_GETSOCKNAME:
  2481.     case O_GETPEERNAME:
  2482.       badsock:
  2483.     fatal("Unsupported socket function");
  2484. #endif /* HAS_SOCKET */
  2485.     case O_SSELECT:
  2486. #ifdef HAS_SELECT
  2487.     sp = do_select(gimme,arglast);
  2488.     goto array_return;
  2489. #else
  2490.     fatal("select not implemented");
  2491. #endif
  2492.     case O_FILENO:
  2493.     if (maxarg < 1)
  2494.         goto say_undef;
  2495.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2496.         stab = arg[1].arg_ptr.arg_stab;
  2497.     else
  2498.         stab = stabent(str_get(st[1]),TRUE);
  2499.     if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
  2500.         goto say_undef;
  2501.     value = fileno(fp);
  2502.     goto donumset;
  2503.     case O_BINMODE:
  2504.     if (maxarg < 1)
  2505.         goto say_undef;
  2506.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2507.         stab = arg[1].arg_ptr.arg_stab;
  2508.     else
  2509.         stab = stabent(str_get(st[1]),TRUE);
  2510.     if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
  2511.         goto say_undef;
  2512.     str_set(str, Yes);
  2513.     STABSET(str);
  2514.     break;
  2515.     case O_VEC:
  2516.     sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
  2517.     goto array_return;
  2518.     case O_GPWNAM:
  2519.     case O_GPWUID:
  2520.     case O_GPWENT:
  2521. #ifdef HAS_PASSWD
  2522.     sp = do_gpwent(optype,
  2523.       gimme,arglast);
  2524.     goto array_return;
  2525.     case O_SPWENT:
  2526.     value = (double) setpwent();
  2527.     goto donumset;
  2528.     case O_EPWENT:
  2529.     value = (double) endpwent();
  2530.     goto donumset;
  2531. #else
  2532.     case O_EPWENT:
  2533.     case O_SPWENT:
  2534.     fatal("Unsupported password function");
  2535.     break;
  2536. #endif
  2537.     case O_GGRNAM:
  2538.     case O_GGRGID:
  2539.     case O_GGRENT:
  2540. #ifdef HAS_GROUP
  2541.     sp = do_ggrent(optype,
  2542.       gimme,arglast);
  2543.     goto array_return;
  2544.     case O_SGRENT:
  2545.     value = (double) setgrent();
  2546.     goto donumset;
  2547.     case O_EGRENT:
  2548.     value = (double) endgrent();
  2549.     goto donumset;
  2550. #else
  2551.     case O_EGRENT:
  2552.     case O_SGRENT:
  2553.     fatal("Unsupported group function");
  2554.     break;
  2555. #endif
  2556.     case O_GETLOGIN:
  2557. #ifdef HAS_GETLOGIN
  2558.     if (!(tmps = getlogin()))
  2559.         goto say_undef;
  2560.     str_set(str,tmps);
  2561. #else
  2562.     fatal("Unsupported function getlogin");
  2563. #endif
  2564.     break;
  2565.     case O_OPEN_DIR:
  2566.     case O_READDIR:
  2567.     case O_TELLDIR:
  2568.     case O_SEEKDIR:
  2569.     case O_REWINDDIR:
  2570.     case O_CLOSEDIR:
  2571.     if (maxarg < 1)
  2572.         goto say_undef;
  2573.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2574.         stab = arg[1].arg_ptr.arg_stab;
  2575.     else
  2576.         stab = stabent(str_get(st[1]),TRUE);
  2577.     if (!stab)
  2578.         goto say_undef;
  2579.     sp = do_dirop(optype,stab,gimme,arglast);
  2580.     goto array_return;
  2581.     case O_SYSCALL:
  2582.     value = (double)do_syscall(arglast);
  2583.     goto donumset;
  2584.     case O_PIPE_OP:
  2585. #ifdef HAS_PIPE
  2586.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2587.         stab = arg[1].arg_ptr.arg_stab;
  2588.     else
  2589.         stab = stabent(str_get(st[1]),TRUE);
  2590.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2591.         stab2 = arg[2].arg_ptr.arg_stab;
  2592.     else
  2593.         stab2 = stabent(str_get(st[2]),TRUE);
  2594.     do_pipe(str,stab,stab2);
  2595.     STABSET(str);
  2596. #else
  2597.     fatal("Unsupported function pipe");
  2598. #endif
  2599.     break;
  2600. #ifdef macintosh
  2601.     case O_ASK:
  2602.     str = do_ask(arglast, maxarg);
  2603.     break;
  2604.     case O_ANSWER:
  2605.     value = do_answer(arglast);
  2606.     goto donumset;
  2607.     case O_PICK:
  2608.     str = do_pick(arglast);
  2609.     break;
  2610. #endif
  2611.     }
  2612.  
  2613.   normal_return:
  2614.     st[1] = str;
  2615. #ifdef DEBUGGING
  2616.     if (debug) {
  2617.     dlevel--;
  2618.     if (debug & 8)
  2619.         deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
  2620.     }
  2621. #endif
  2622.     return arglast[0] + 1;
  2623.  
  2624. array_return:
  2625. #ifdef DEBUGGING
  2626.     if (debug) {
  2627.     dlevel--;
  2628.     if (debug & 8) {
  2629.         anum = sp - arglast[0];
  2630.         switch (anum) {
  2631.         case 0:
  2632.         deb("%s RETURNS ()\n",opname[optype]);
  2633.         break;
  2634.         case 1:
  2635.         deb("%s RETURNS (\"%s\")\n",opname[optype],
  2636.             st[1] ? str_get(st[1]) : "");
  2637.         break;
  2638.         default:
  2639.         tmps = st[1] ? str_get(st[1]) : "";
  2640.         deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
  2641.           anum,tmps,anum==2?"":"...,",
  2642.             st[anum] ? str_get(st[anum]) : "");
  2643.         break;
  2644.         }
  2645.     }
  2646.     }
  2647. #endif
  2648.     return sp;
  2649.  
  2650. say_yes:
  2651.     str = &str_yes;
  2652.     goto normal_return;
  2653.  
  2654. say_no:
  2655.     str = &str_no;
  2656.     goto normal_return;
  2657.  
  2658. say_undef:
  2659.     str = &str_undef;
  2660.     goto normal_return;
  2661.  
  2662. say_zero:
  2663.     value = 0.0;
  2664.     /* FALL THROUGH */
  2665.  
  2666. donumset:
  2667.     str_numset(str,value);
  2668.     STABSET(str);
  2669.     st[1] = str;
  2670. #ifdef DEBUGGING
  2671.     if (debug) {
  2672.     dlevel--;
  2673.     if (debug & 8)
  2674.         deb("%s RETURNS \"%f\"\n",opname[optype],value);
  2675.     }
  2676. #endif
  2677.     return arglast[0] + 1;
  2678. }
  2679.  
  2680. #ifdef macintosh
  2681. void reinit_eval()
  2682. {
  2683.     debarg = NULL;
  2684.     memset(&str_args, 0, sizeof(STR));
  2685.     old_rschar = 0;
  2686.     old_rslen = 0;
  2687. }
  2688. #endif
  2689.